#!/usr/bin/perl -c

package PIPL::Class::Singleton;
use 5.006;
our $VERSION = '0.01';

=head1 NAME

PIPL::Class::Singleton - Singleton class implementation

=head1 SYNOPSIS

  package My::Singleton;
  use base 'PIPL::Class::Singleton';

  sub new {
    my $class = shift;
    $class = ref $class if ref $class;
    
    my $self = $class->SUPER::new(@_);
    
    $self->{field} = 0;

    return $self;
  }
  
  __PACKAGE__->instance;

  1;

  package main;

  my $obj1 = instance My::Singleton;
  $obj1->{field} = 1;
  my $obj2 = instance My::Singleton;
  print $obj2->{field};  # 1: this is the same object
  print $My::Singleton::Self->{field};  # 1: also the same object

=head1 DESCRIPTION

This is a base class for other classes which are implemented as singleton class.

The class provides the B<instance> method which creates new object instance. 
The package scoped variable B<$Self> is also created.  This variable contains
the reference to the singleton object.

=cut


use strict;
no strict 'refs';


# Constructor stub
sub new {
    my $class = shift;
    $class = ref $class if ref $class;

    my $self = {};
    bless $self => $class;

    return $self;
}


# Singleton constructor
sub instance {
    my $class = shift;
    $class = ref $class if ref $class;

    my $sym = "${class}::Self";
    return defined $$sym ? $$sym : ($$sym = $class->new);
}


# Singleton destructor
sub destroy {
    my $class = shift;
    $class = ref $class if ref $class;

    my $sym = "${class}::Self";
    return $$sym = undef;
}


1;


=head1 VARIABLES

=over

=item $Self

The reference to the singleton object.

=back

=head1 CONSTRUCTORS

=over

=item new

Creates the object as a blessed empty hash reference.  This method is a stub
for more useful methods implemented in derived classes.

=item instance

Returns the reference to the singleton object.  If the object is not created currently,
it calls the B<new> constructor.

The B<instance> method is not called automatically at start, so the derived class
should call it if the static object is used.

  package My::Singleton;
  use base 'PIPL::Class::Singleton';
  __PACKAGE__->instance;
  
  package main;
  $My::Singleton::Self->{foo} = 'bar';

=back

=head1 DESTRUCTORS

=over

=item destroy

Destroys the singleton object.  After that it has to be created with
B<instance> method again.

The B<destroy> method does not free all references to singleton object.  As
far as the other referennces exist, the real object still alive.

=back

=head1 TESTS

The module was tested with L<Devel::Cover> and L<Devel::Dprof>.

=head1 BUGS

If you find the bug, please report it.

=head1 AUTHORS

Piotr Roszatycki E<lt>dexter@debian.orgE<gt>

=head1 LICENSE

Copyright 2007 by Piotr Roszatycki E<lt>dexter@debian.orgE<gt>.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

See L<http://www.perl.com/perl/misc/Artistic.html>
